; ORIGINAL: 3dt2.1/examples/rotsph.scm
; $Id: rotsph.scm,v 1.5 1997/04/30 20:24:18 jread Exp $
;- rotsph.scm -----------------------------------------------------
; Perform Spherical rotation of views.
; (rotate #t) turns on rotation. and (rotate #f) turns off rotation.
;------------------------------------------------------------------
(require 'old-rb "old-rb.scm")
(require 'math "math.scm")

(define rotsph
  (lambda (onoff)
    (let* ((orig-view #f)
           (radius 1)
           (prev-event #f))
      (if onoff
          ;; TRUE: Define mouse hooks for tracking position
          (begin
            ;; When button pressed, save original view info & start tracking
            (set! mouse-down-hook
                  (lambda (pe)
                    (begin
                      (set! orig-view (event:view pe))
                      (set! radius (/ (min (view:width orig-view)
                                           (view:height orig-view)) 6.4))
                      (set! prev-event pe)
                      (dl:dynamic-silhouette-display #f)
                      (rb:scheme #t)
                      )
                    )
                  )
            ;; As mouse moves, update view and refresh
            (set! rb-update-hook
                  (lambda (pe)
                    (if orig-view
                        (let* ((vt (view:target orig-view))
                               (vn (gvector:from-to vt (view:eye orig-view)))
                               (p1 (pick:position prev-event vt vn))
                               (p2 (pick:position pe vt vn))
                               (v1 (gvector:from-to p1 p2))
                               (p3 (position:project-to-line vt p1 v1))
                               (d3 (min (position:distance vt p3) radius))
                               (h (sqrt (- (* radius radius) (* d3 d3))))
                               (v2 (gvector:scale (gvector:unitize vn) h))
                               (p4 (position:offset p1 v2))
                               (v4 (gvector:from-to vt p4))
                               (axis (gvector:cross v1 v4))
                               (angle (radians->degrees (/ (gvector:length v1)
                                                           (max (position:distance vt p3) radius))))
                               )
                          (view:set-eye (position:transform (view:eye orig-view)
                                                            (transform:rotation (view:target orig-view) axis angle))
                                        orig-view)
                          (view:set-up (gvector:transform (view:up orig-view)
                                                          (transform:rotation (position 0 0 0) axis angle))
                                       orig-view)
                          (view:refresh orig-view)
                          (set! prev-event pe)
                          )
                        )
                    )
                  )
            ;; When button released, stop tracking
            (set! mouse-up-hook
                  (lambda (pe)
                    (rb:scheme #f)
                    (dl:dynamic-silhouette-display #t)
                    (rb-update-hook pe)
                    (set! orig-view #f)
                    )
                  )
            ;; Clear the other scheme rubberbanding hooks
            (set! rb-init-hook '())
            (set! rb-start-hook '())
            (set! rb-stop-hook '())
            (set! rb-end-hook '())
            (set! rb-repaint-hook '())
            )
          ;; FALSE: Turn off tracking capability
          (begin
            (set! mouse-down-hook '())
            (set! mouse-up-hook '())
            (set! rb-update-hook '())
            )
          )
      ;; Return the new setting
      onoff
      )
    )
  )

